home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Ham Radio 2000
/
Ham Radio 2000.iso
/
ham2000
/
misc
/
icom_cat
/
program4.bas
< prev
next >
Wrap
BASIC Source File
|
1993-08-04
|
9KB
|
332 lines
'
' Program 1 (PARAMETER READING)
'
' Program taken from the "CT-17 Communication Interface-V (CI-V) Level
' Converter Instruction Manual". Program converted to IBM QBASIC by Bill
' Heaton, N7WRI.
'
DEFINT G-Z
DECLARE SUB DoCommand (Cmd AS INTEGER, Arg AS STRING)
DECLARE SUB GetEcho (Echo AS STRING)
DECLARE SUB GetReply ()
DECLARE SUB GetRig (rig AS STRING)
DECLARE SUB GetTranceive (Tranceive AS STRING)
DECLARE SUB SetupBCD ()
DECLARE SUB SetupCOM ()
DECLARE SUB ShowLimit (Args AS STRING)
DECLARE SUB ShowFreq (Args AS STRING)
DECLARE SUB ShowMainPrompts ()
DECLARE SUB ShowMode (Args AS STRING)
DECLARE SUB ShowOffset (Args AS STRING)
DECLARE FUNCTION BCDtoINT& (BcdString AS STRING, Numbytes AS INTEGER)
DECLARE FUNCTION GetChan$ ()
DECLARE FUNCTION STRTOHEX$ (Str AS STRING)
DIM SHARED BCD$(100)
'
' Configuration Information
'
CONST RA = &H3C ' Receive Address (IC-737)
CONST TA = &HE0 ' Transmit Address (Computer)
CONST FREQCNT = 5 ' Number of bytes in frequency (IC-737 uses 5)
CONST PORT$ = "COM1" ' Serial Port to use
CONST PORTNO = 1 ' Serial Port to use
CONST CONF$ = "1200,N,8,1" ' Baud rate, Parity, Bits, Stop Bits
CONST SHOWCOM = 1 ' Show Com Packets ( 0=No, 1=Yes)
'
' Initialize
'
SetupCOM
ShowMainPrompts
ShowFreq (CHR$(&H54) + CHR$(&H76) + CHR$(&H98) + CHR$(&H28) + CHR$(&H12))
ShowMode (CHR$(6) + CHR$(2))
ShowOffset (CHR$(&H56) + CHR$(&H34) + CHR$(&H12))
a$ = CHR$(&H54) + CHR$(&H76) + CHR$(&H98) + CHR$(&H28) + CHR$(&H12)
b$ = CHR$(&H12) + CHR$(&H23) + CHR$(&H45) + CHR$(&H67) + CHR$(&H15)
ShowLimit (a$ + CHR$(&H2D) + b$)
'
' Endless loop until an event handler kills us
'
DO UNTIL TRUE
LOOP
'
' Event Handlers
'
Serial: GetReply: RETURN
F1: DoCommand &H2, "": RETURN
F2: DoCommand &H3, "": RETURN
F3: DoCommand &H4, "": RETURN
F4: DoCommand &HC, "": RETURN
F0: CLOSE : SYSTEM
'
' BCDtoINT& Convert BCD to an Integer.
'
'
FUNCTION BCDtoINT& (BcdString AS STRING, Numbytes AS INTEGER)
DA$ = ""
FOR i% = 1 TO Numbytes
DA$ = RIGHT$("00" + HEX$(ASC(MID$(BcdString, i%, 1))), 2) + DA$
NEXT i%
BCDtoINT& = VAL(DA$)
END FUNCTION
' +---------------------------------------------------------------------+
' | |
' | ICOM CI-V Packet Layout |
' | +----------+----------+---------+---------+---------+------+ |
' | | Preamble | Transmit | Receive | Command | Sub | EOM | |
' | | <FE><FE> | Address | Address | | Command | <FD> | |
' | +----------+----------+---------+---------+---------+------+ |
' | |
' | A packet consists of two bytes of &HFE, one byte for the |
' | transmit address (Controller), One byte receive address |
' | (Rig), one byte command, one to five byte subcommand, and |
' | finally the tail of one byte of &HFD. |
' | |
' +---------------------------------------------------------------------+
SUB DoCommand (Cmd AS INTEGER, SubCmd AS STRING)
'
' Create the packet and send it out
'
Out$ = CHR$(&HFE) + CHR$(&HFE) + CHR$(RA) + CHR$(TA) + CHR$(Cmd) + SubCmd + CHR$(&HFD)
PRINT #1, Out$;
'
' If we're watching packets, send to the screen in hex
'
IF SHOWCOM THEN
LOCATE 16, 1: PRINT "Sent: ": LOCATE 16, 7: PRINT STRTOHEX$(Out$); SPACE$(50);
LOCATE 17, 1: PRINT "Echo: "; SPACE$(50);
LOCATE 18, 1: PRINT "Rig: "; SPACE$(50);
LOCATE 19, 1: PRINT "Tncv: "; SPACE$(50);
END IF
END SUB
SUB GetEcho (Echo AS STRING)
'
' Echo replys to the screen if we were told to
'
IF SHOWCOM THEN
LOCATE 17, 7: PRINT STRTOHEX$(Echo);
END IF
END SUB
'
' GetReply - Character has arrived from rig, stuff it away until
' have an entire packet and display it.
'
SUB GetReply
STATIC Hold$
'
' Accumulate the Reply, if its not end of packet get out early
'
Hold$ = Hold$ + INPUT$(LOC(PORTNO), PORTNO)
IF INSTR(Hold$, CHR$(&HFD)) = 0 THEN
EXIT SUB
END IF
SELECT CASE MID$(Hold$, 3, 1) ' Who was the packet from?
CASE CHR$(RA): GetEcho (Hold$) ' - Controller
CASE CHR$(TA): GetRig (Hold$) ' - Rig
CASE CHR$(0): GetTranceive (Hold$) ' - Transceive Function
END SELECT
' Get ready for next reply
Hold$ = ""
END SUB
SUB GetRig (rig AS STRING)
'
' Echo replys to the screen if we were told to
'
IF SHOWCOM THEN
LOCATE 18, 7: PRINT STRTOHEX$(rig);
END IF
SELECT CASE MID$(rig, 5, 1)
CASE CHR$(&HFF): LOCATE 25, 1: PRINT "[BLANK] ";
CASE CHR$(&HFB): LOCATE 25, 1: PRINT "[OK] ";
CASE CHR$(&HFA): LOCATE 25, 1: PRINT "[ERROR] ";
CASE CHR$(&H2): ShowLimit (MID$(rig, 6))
CASE CHR$(&H3): ShowFreq (MID$(rig, 6))
CASE CHR$(&H4): ShowMode (MID$(rig, 6))
CASE CHR$(&HC): ShowOffset (MID$(rig, 6))
CASE ELSE: LOCATE 25, 1: PRINT "[Unknown]";
END SELECT
END SUB
SUB GetTranceive (Tranceive AS STRING)
'
' Echo replys to the screen if we were told to
'
IF SHOWCOM THEN
LOCATE 19, 7: PRINT STRTOHEX$(Tranceive);
END IF
LOCATE 25, 1: PRINT "[Track] ";
SELECT CASE MID$(Tranceive, 5, 1)
CASE CHR$(&H0): ShowFreq (MID$(Tranceive, 6))
CASE CHR$(&H1): ShowMode (MID$(Tranceive, 6))
CASE ELSE: LOCATE 25, 1: PRINT "[UnTrack]";
END SELECT
END SUB
'
' Setup the channel to the serial port
'
SUB SetupCOM
OPEN PORT$ + ":" + CONF$ + ",CD0,CS0,DS0,OP0,RS" FOR RANDOM AS #1
ON COM(PORTNO) GOSUB Serial
COM(PORTNO) ON
END SUB
DEFDBL F
SUB ShowFreq (Args AS STRING)
LOCATE 8, 2
PRINT USING "#,###,###,###"; BCDtoINT(Args, FREQCNT)
END SUB
DEFSNG F
SUB ShowLimit (Args AS STRING)
LOCATE 8, 50
PRINT USING "#,###,###,###"; BCDtoINT(Args, FREQCNT)
a$ = MID$(Args, FREQCNT + 2)
LOCATE 8, 65
PRINT USING "#,###,###,###"; BCDtoINT(a$, FREQCNT)
END SUB
SUB ShowMainPrompts
CLS
'
' Paint the Output Fields
'
T1$ = " ┌────────── Limits ───────────┐"
T2$ = " Frequency Mode IF Width Offset Lower Upper "
T3$ = "┌──────────────┬─────────┐ ┌────────┐ ┌───────┐ ┌──────────────┬──────────────┐"
T4$ = "│ │ │ │ │ │ │ │ │ │"
T5$ = "└──────────────┴─────────┘ └────────┘ └───────┘ └──────────────┴──────────────┘"
LOCATE 5, 1: PRINT T1$;
LOCATE 6, 1: PRINT T2$;
LOCATE 7, 1: PRINT T3$;
LOCATE 8, 1: PRINT T4$;
LOCATE 9, 1: PRINT T5$;
'
' Paint the prompts
'
M1$ = "╔═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦═══════╦══════╗"
M2$ = "║ F1 ║ F2 ║ F3 ║ F4 ║ ║ ║ ║ ║ ║ F10 ║"
M3$ = "║ Limits║ Freq ║ Mode ║ Offset║ ║ ║ ║ ║ ║ EXIT ║"
M4$ = "╚═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩═══════╩══════╝"
LOCATE 21, 1: PRINT M1$;
LOCATE 22, 1: PRINT M2$;
LOCATE 23, 1: PRINT M3$;
LOCATE 24, 1: PRINT M4$;
VIEW PRINT 1 TO 20
'
' Setup function key handlers for each options
'
ON KEY(1) GOSUB F1
ON KEY(2) GOSUB F2
ON KEY(3) GOSUB F3
ON KEY(4) GOSUB F4
ON KEY(10) GOSUB F0
'
' Turn the key handlers on
'
FOR i = 1 TO 4
KEY(i%) ON
NEXT i
KEY(10) ON
END SUB
SUB ShowMode (Args AS STRING)
LOCATE 8, 17
SELECT CASE MID$(Args, 1, 1)
CASE CHR$(0): PRINT " LSB ";
CASE CHR$(1): PRINT " USB ";
CASE CHR$(2): PRINT " AM ";
CASE CHR$(3): PRINT " CW ";
CASE CHR$(4): PRINT " RTTY ";
CASE CHR$(5): PRINT " FM ";
CASE CHR$(6): PRINT " Wide-FM ";
CASE ELSE: PRINT USING " ## "; HEX$(ASC(MID$(Args, 1, 1)))
END SELECT
LOCATE 8, 29
SELECT CASE MID$(Args, 2, 1)
CASE CHR$(0): PRINT " ";
CASE CHR$(1): PRINT " Wide ";
CASE CHR$(2): PRINT " Narrow ";
CASE ELSE: PRINT USING " ## "; HEX$(ASC(MID$(Args, 2, 1)))
END SELECT
END SUB
SUB ShowOffset (Args AS STRING)
i& = BCDtoINT(Args, 3)
f = CDBL(i&) / 100000
LOCATE 8, 40
PRINT USING "#.#####"; f
END SUB
' STRTOHEX$ - Translate all the characters in a string to hex and
' return the resulting string.
'
FUNCTION STRTOHEX$ (Str AS STRING)
Scn$ = ""
FOR i = 1 TO LEN(Str)
C$ = HEX$(ASC(MID$(Str, i, 1)))
Scn$ = Scn$ + C$ + " "
NEXT i
STRTOHEX$ = Scn$
END FUNCTION